A primeira seção desta lista trata de séries de escopo relativamente específicos, quais sejam, séries temporais de natureza econômica. Tais tipos de séries constituem bons exemplos para avaliação dos conceitos vistos na segunda aula do curso, como ciclo, sazonalidade, tendência, e visualização de dados temporais. As questões dessa seção também são relativamente mais direcionadas, tendo em mente os conceitos vistos em aula
Na sequência, a Parte 2 das questões trará datasets com séries de outra natureza, abrindo também o escopo das questões de forma a permitir a livre exploração do rico conjunto de dados disponibilizado.
library(tidyverse)
## -- Attaching packages ------------------------------------------------------------ tidyverse 1.3.0 --
## v ggplot2 3.3.0 v purrr 0.3.3
## v tibble 2.1.3 v dplyr 0.8.5
## v tidyr 1.0.2 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.5.0
## -- Conflicts --------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
detach("package:dplyr")
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(janitor)
##
## Attaching package: 'janitor'
## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.test
library(readxl)
library(forecast)
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library(mafs)
Lendo o arquivo RDS “us_change”. Trate-se de um tibble de variáveis trimestrais contendo as variações percentual no gastos privados com consumo, renda disponível, produção, popuplção e taxa de desemprego no Estados Unidos entre 1970 e 2016. As taxas de variação foram obtidas a partir de em valores reais medidos em dólares americanos de 2012.
load(file = "./references/us_change.rda")
us_change <- us_change %>% clean_names
View(us_change)
#Carregando o nome das colunas
columns <- colnames(us_change)
col <- columns[[1]]
i_ref <- match(as.Date("2000-01-01"), us_change[[col]])
us_change_nivel <- us_change
#Gerando o número índice
for (i in 2:length(columns)) {
col <- columns[i]
us_change_nivel[[col]][i_ref] <- 100
for(j in 1:length(us_change_nivel[[col]])) {
if (j != i_ref) {
#print(paste(col, us_change_nivel[[col]][j], us_change_nivel[[col]][i_ref]))
us_change_nivel[[col]][j] <- (1 + us_change_nivel[[col]][j]/100) * us_change_nivel[[col]][i_ref]
}
}
}
View(us_change_nivel)
## consumption income production savings unemployment
## consumption 1.00 0.38 0.53 -0.26 -0.53
## income 0.38 1.00 0.27 0.72 -0.22
## production 0.53 0.27 1.00 -0.06 -0.77
## savings -0.26 0.72 -0.06 1.00 0.11
## unemployment -0.53 -0.22 -0.77 0.11 1.00
graf_tl <-
ggplot(us_change, aes(x=quarter)) +
geom_line(aes(y=consumption, color = "Consumo")) +
geom_line(aes(y=income, color = "Renda")) +
geom_line(aes(y=production, color = "Produção")) +
geom_line(aes(y=savings, color = "Poupança")) +
geom_line(aes(y=unemployment, color = "Desemprego"))+
labs(subtitle = "Evolução ao longo do tempo",
y = "Variação", x = "Trimestre", color = "Índice")
plotly::ggplotly(graf_tl)
Fazendo uma correlação entre desemprego e consumo, percebemos que a medida que o desemprego aumenta o consumo diminui
graf_cons_unemp <-
ggplot(us_change, aes(y=consumption, x=unemployment)) +
geom_point(aes(col=consumption)) +
geom_smooth(method="loess") +
labs(subtitle = "Desemprego vs Consumo",
x = "Desemprego", y = "Consumo", color = "Desemprego")
plotly::ggplotly(graf_cons_unemp)
## `geom_smooth()` using formula 'y ~ x'
Fazendo uma correlação entre desemprego e produção, percebemos que a medida que a produção aumenta, o desemprego diminui
graf_prod_unemp <-
ggplot(us_change, aes(y=production, x=unemployment)) +
geom_point(aes(col=production)) +
geom_smooth(method="loess") +
labs(subtitle = "Desemprego vs Produção",
x = "Desemprego", y = "Produção", color = "Desemprego")
plotly::ggplotly(graf_prod_unemp)
## `geom_smooth()` using formula 'y ~ x'
Fazendo uma correlação entre recexita e poupança, percebemos que a medida que a receita aumenta, as pessoas tendem a poupar
graf_sav_income <-
ggplot(us_change, aes(y=savings, x=income)) +
geom_point(aes(col=savings)) +
geom_smooth(method="loess") +
labs(subtitle = "Receita vs Poupança",
x = "Receita", y = "Poupança", color = "Receita")
plotly::ggplotly(graf_sav_income)
## `geom_smooth()` using formula 'y ~ x'
outlier_values <- boxplot.stats(us_change$savings)$out
graf_tl_saving <-
ggplot(us_change, aes(x=quarter)) +
geom_point(aes(y=savings, color = ifelse((savings %in% outlier_values),
"Poupança fora do desvio padrão",
"Poupança"))) +
labs(subtitle = "Evolução ao longo do tempo da poupança",
y = "Variação",
x = "Trimestre",
color = "Índice")
plotly::ggplotly(graf_tl_saving)
O arquivo “retail.xlsx” contém informações sobre vendas mensais de varejo para diversos estados da Austrália.
retail <- read_excel("./references/retail.xlsx")
## New names:
## * `` -> ...1
retail <- retail[-c(1),] %>%
clean_names %>%
rename(month = colnames(.)[1]) %>%
mutate(month = as.Date(as.numeric(month), origin = "1899-12-30"))
View(retail)
head(retail)
retail_ds <- retail %>%
select(c("turnover_western_australia_department_stores"))
# Gerando uma série temporal
ts_department_stores <- ts(retail_ds, start=c(1982, 4), end=c(2013, 12), frequency=12)
# Plotando a série temporal
plot (ts_department_stores, main="Loja de Departamento", xlab="Tempo", ylab="Valores")
O elemento sazonal da série pode ser analisado nos dois gráficos a seguir:
# Função ggmonthplot do pacote forecast
ggmonthplot(ts_department_stores)
# Visualizar decomposição sazonal da série
ts_department_stores %>%
decompose %>%
plot
# estratificação por mês
ggseasonplot(ts_department_stores, year.labels = TRUE) +
geom_point() +
theme_bw()
Podemos perceber nos gráficos anteriores que o mês de maior movimento nas lojas de departamento são em dezembro, provavelmente devido ao período do Natal e a recebimento do 13º salário. O segundo mês de maior movimento é maio devido ao dia das Mães. Outro ponto importante é que a medida que os anos foram passando o comércio foi aumentando seus rendimentos até 2008
O Gráfico a seguir mostra a previsão do ano de 2014 baseado no algorítmo de ML Nnetar
apply_selected_model(ts_department_stores, "nnetar", horizon = 12) %>%
forecast(h = 12) %>%
plot
A ideia desta segunda parte da avaliação é propiciar aos alunos oportunidade de aplicar todo o ferramental aprendido em datasets razoavelmente ricos e propícios à analises descritivas. Aqui não será pedido nenhum tipo de análise específica, mas sim que o aluno explore ao máximo as bases, de modo a transformar dado em informação útil e de fácil absorção! Todo tipo de insight e análise que puder ser retirado das bases é útil, pois ajuda a compreender fenômenos implícitos nos dados. Usem e abusem dos pacotes e funções aprendidas, do Google e do material complementar recomendado no material. Ambos datasets fazem parte do chamado “Tidy Tuesday”, um evento semanal onde a cada terça-feira um novo dataset e disponibilizado e membro da comu- nidade R fazem análises e/ou aplicam visualizações interessantes e novas.
Os autores do package compilaram mais de 5.000 músicas de gêneros e subgêneros distintos. O descritivo do dataset, bem como a obtenção dos dados em si, está toda no seguinte repositório: <https://github.com/rfordatascience/tidytuesday/ blob/master/data/2020/2020-01-21/readme.md>
# Get the Data
spotify_songs <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-01-21/spotify_songs.csv')
## Parsed with column specification:
## cols(
## .default = col_double(),
## track_id = col_character(),
## track_name = col_character(),
## track_artist = col_character(),
## track_album_id = col_character(),
## track_album_name = col_character(),
## track_album_release_date = col_character(),
## playlist_name = col_character(),
## playlist_id = col_character(),
## playlist_genre = col_character(),
## playlist_subgenre = col_character()
## )
## See spec(...) for full column specifications.
## key danceability energy loudness speechiness acousticness
## key 1.00 0.01 0.01 0.00 0.02 0.00
## danceability 0.01 1.00 -0.09 0.03 0.18 -0.02
## energy 0.01 -0.09 1.00 0.68 -0.03 -0.54
## loudness 0.00 0.03 0.68 1.00 0.01 -0.36
## speechiness 0.02 0.18 -0.03 0.01 1.00 0.03
## acousticness 0.00 -0.02 -0.54 -0.36 0.03 1.00
## instrumentalness 0.01 -0.01 0.03 -0.15 -0.10 -0.01
## liveness 0.00 -0.12 0.16 0.08 0.06 -0.08
## track_popularity 0.00 0.06 -0.11 0.06 0.01 0.09
## instrumentalness liveness track_popularity
## key 0.01 0.00 0.00
## danceability -0.01 -0.12 0.06
## energy 0.03 0.16 -0.11
## loudness -0.15 0.08 0.06
## speechiness -0.10 0.06 0.01
## acousticness -0.01 -0.08 0.09
## instrumentalness 1.00 -0.01 -0.15
## liveness -0.01 1.00 -0.05
## track_popularity -0.15 -0.05 1.00
#library(dplyr)
#library(data.table)
# songs_beatles <-
# spotify_songs %>%
# filter(track_artist %like% "Beatles")
#
# #install.packages("ggjoy")
# library(ggjoy)
#
# ggplot(songs_beatles, aes(x = valence, y = track_album_name)) +
# geom_joy() +
# theme_joy() +
# ggtitle("Joyplot of Beatles distributions")
O dataset contém dados como a data de lançamento, desenvolvedor, tempo médio jogado, etc. O descritivo do dataset, bem como a obtenção dos dados em si, está toda no seguinte repositório: https://github.com/rfordatascience/tidytuesday/tree/master/data/2019/2019-07-30
library(tidyverse)
# clean dataset from lizawood's github
url <- "https://raw.githubusercontent.com/lizawood/apps-and-games/master/PC_Games/PCgames_2004_2018_raw.csv"
# read in raw data
raw_df <- url %>%
read_csv() %>%
janitor::clean_names()
## Parsed with column specification:
## cols(
## `#` = col_double(),
## Game = col_character(),
## `Release date` = col_character(),
## Price = col_character(),
## `Score rank(Userscore / Metascore)` = col_character(),
## Owners = col_character(),
## `Playtime (Median)` = col_character(),
## `Developer(s)` = col_character(),
## `Publisher(s)` = col_character()
## )
# clean up some of the factors and playtime data
clean_df <- raw_df %>%
mutate(price = as.numeric(price),
score_rank = word(score_rank_userscore_metascore, 1),
average_playtime = word(playtime_median, 1),
median_playtime = word(playtime_median, 2),
median_playtime = str_remove(median_playtime, "\\("),
median_playtime = str_remove(median_playtime, "\\)"),
owner_min = as.numeric(unlist(strsplit(gsub("," ,"", "10,000,000 .. 20,000,000"), ' .. '))[1]),
owner_max = as.numeric(unlist(strsplit(gsub("," ,"", "10,000,000 .. 20,000,000"), ' .. '))[2]),
average_playtime = 60 * as.numeric(str_sub(average_playtime, 1, 2)) +
as.numeric(str_sub(average_playtime, 4, 5)),
median_playtime = 60 * as.numeric(str_sub(median_playtime, 1, 2)) +
as.numeric(str_sub(median_playtime, 4, 5)),
metascore = as.double(str_sub(score_rank_userscore_metascore, start = -4, end = -3))) %>%
select(-score_rank_userscore_metascore, -score_rank, -playtime_median) %>%
rename(publisher = publisher_s, developer = developer_s)
## Warning: NAs introduzidos por coerção
## Warning: NAs introduzidos por coerção
## Warning: NAs introduzidos por coerção
## Warning: NAs introduzidos por coerção
game_by_developer <- clean_df %>%
group_by(developer)
developer_gain <- game_by_developer %>%
summarise(
gain_min = sum(price * owner_min),
gain_max = sum(price * owner_max)) %>%
top_n(10)
## Selecting by gain_max
developer_gain_gather<-developer_gain %>%
gather(gain, value, gain_min:gain_max)
developer_gain_gather %>%
# Stacked barplot with multiple groups
ggplot(aes(x=developer, y=value, fill=gain)) +
geom_bar(stat="identity")